home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1986 March / 64er_Magazin_86-03_1986_Markt__Technik_de.d64 / umformer print-s (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  390 lines
  1. 10 v=53248
  2. 20 pokev+21,0 : pokev+29,0 : pokev+23,0 : pokev+16,0
  3. 30 printchr$(142);chr$(8)
  4. 40 poke53280,11:poke53281,12:poke646,0
  5. 50 print"[147]           print-shop-umformer          [146]";
  6. 60 print"                                        [146]";
  7. 70 print"        von andreas nothaft 1985        [146]";
  8. 80 print"  0 [146] - programm-ende"
  9. 90 print"  1 [146] - informationen"
  10. 100 print"  2 [146] - directory anzeigen"
  11. 110 print"----------------------------------------";
  12. 120 print"  3 [146] - 1 hires-sprite "
  13. 130 print"  4 [146] - 1 multi-c-sprite (normalgroesse)"
  14. 140 print"  5 [146] - 2 hires-sprites (nebeneinander)"
  15. 150 print"  6 [146] - 2 hires-sprites (uebereinader)"
  16. 160 print"  7 [146] - 4 hires-sprites"
  17. 170 getg$:ifg$=""then170
  18. 180 if g$="0" then 270
  19. 190 if g$="1" then 310
  20. 200 if g$="2" then 3730
  21. 210 if g$="3" then 520
  22. 220 if g$="4" then 910
  23. 230 if g$="5" then 1810
  24. 240 if g$="6" then 2140
  25. 250 if g$="7" then 2600
  26. 260 goto 170
  27. 270 print"[147]sind sie sicher ??? (j/n)"
  28. 280 get g$:ifg$="" then 280
  29. 290 ifg$="j" then sys 64738
  30. 300 run
  31. 310 rem ******************************
  32. 320 rem *****   informationen    *****
  33. 330 rem ******************************
  34. 340 a$="informationen":gosub3090
  35. 350 print" dieses programm veraendert die daten"
  36. 360 print" von sprites so, dass sie von dem"
  37. 370 print" programm ";chr$(34);"print shop";chr$(34);" verwendet"
  38. 380 print" werden koennen."
  39. 390 print" aufgrund der aufloesungs-punkte"
  40. 400 print" funktioniert dieses programm nur mit"
  41. 410 print" der print shop version fuer"
  42. 420 print"     nicht commodore drucker[146]."
  43. 430 print" die einzulesenden daten koennen"
  44. 440 print" entweder aus einer sequentiellen datei"
  45. 450 print" oder aus einem programm-file bestehen."
  46. 460 print" es werden jeweils nur die ersten "
  47. 470 print" 63 bytes gelesen."
  48. 480 print"   viel erfolg mit diesem prg wuenscht"
  49. 490 print"     andreas,  thorsten und matthias    [146]"
  50. 500 gosub3150
  51. 510 run
  52. 520 rem ******************************
  53. 530 rem 1 hires-sprite (normalgroesse)
  54. 540 rem ******************************
  55. 550 az=1:gosub2940
  56. 560 a$="1 hires-sprite (normalgroesse)"
  57. 570 gosub3090 :rem name-amzeigen
  58. 580 pokev+21,3
  59. 590 poke2040,192:poke2041,192
  60. 600 pokev,126:pokev+1,140
  61. 610 pokev+2,170:pokev+3,130
  62. 620 pokev+29,2:pokev+23,2
  63. 630 pokev+39,15:pokev+40,15
  64. 640 gosub3640
  65. 650 pokev+21,0
  66. 660 gosub3050: rem fill mit 00
  67. 670 an=12288 : a1=22584 : z1=0 :z=0:s1=00:b=0
  68. 680 print"";
  69. 690 forth=0to20:printth:next:print"";
  70. 700 for p=1 to 21
  71. 710 print"+"
  72. 720 for m=1 to 3
  73. 730 a=peek(an+z)
  74. 740 for n=21 to 0 step -3
  75. 750 if a>=2^(n/3) then b=b+2^(n+2):b=b+2^(n+1):b=b+2^n :a=a-2^(n/3)
  76. 760 next n : z=z+1
  77. 770 c=int(b/65536):d=int((b-(c*65536))/256):e=b-(c*65536+d*256)
  78. 780 b=0
  79. 790 pokea1+z1+s1,c : pokea1+z1+s1+11,c
  80. 800 pokea1+z1+s1+1,d:pokea1+z1+s1+11+1,d
  81. 810 pokea1+z1+s1+2,e:pokea1+z1+s1+11+2,e
  82. 820 z1=z1+3
  83. 830 next m : s1=s1+22 : z1=0
  84. 840 next p
  85. 850 gosub3220:rem save
  86. 860 gosub3360:rem fehler ???
  87. 870 if a=0 then run
  88. 880 print"  disk-error [146]: ";a;a$;b;c
  89. 890 gosub3150
  90. 900 goto850
  91. 910 rem ******************************
  92. 920 rem *1 multi-c-sprite (normalgr.)*
  93. 930 rem ******************************
  94. 940 az=1:gosub2940
  95. 950 a$="1 multi-c-sprite (normalgr.)"
  96. 960 gosub3090
  97. 970 gosub3050
  98. 980 poke2040,192
  99. 990 poke2041,192
  100. 1000 v=53248
  101. 1010 pokev+21,3
  102. 1020 pokev,220:pokev+1,185
  103. 1030 pokev+2,5:pokev+3,175:pokev+16,2
  104. 1040 pokev+28,3:pokev+29,2:pokev+23,2
  105. 1050 c1=15 : c2=11 : c3=00 : c4=12
  106. 1060 pokev+33,c1 : pokev+37,c2 : pokev+38,c3 : pokev+39,c4 : pokev+40,c4
  107. 1070 print"":fori=1 to 40 :print" ";:next
  108. 1080 print"":fori=1 to 40 :print" ";:next
  109. 1090 a$="1 multi-c-sprite (normalgr.)":gosub3090
  110. 1100 print"  f1 [146] = multi-color-farbe #01"
  111. 1110 print"  f3 [146] = multi-color-farbe #02"
  112. 1120 print"  f5 [146] = multi-color-farbe #03"
  113. 1130 print"  f7 [146] = multi-color-farbe #04"
  114. 1140 print"  f8 [146] = zurueck ins menue"
  115. 1150 print" return = weiter im programm"
  116. 1160 get g$:ifg$=""then1160
  117. 1170 if g$=chr$(133) then gosub 1240
  118. 1180 if g$=chr$(134) then gosub 1290
  119. 1190 if g$=chr$(135) then gosub 1340
  120. 1200 if g$=chr$(136) then gosub 1390
  121. 1210 ifg$=chr$(140)thenrun
  122. 1220 if g$<>chr$(13) then 1160
  123. 1230 goto1440
  124. 1240 if c1=0  then c1=11 : goto1280
  125. 1250 if c1=11 then c1=12 : goto1280
  126. 1260 if c1=12 then c1=15 : goto1280
  127. 1270 if c1=15 then c1=0
  128. 1280 pokev+33,c1:return
  129. 1290 if c2=0  then c2=11 : goto1330
  130. 1300 if c2=11 then c2=12 : goto1330
  131. 1310 if c2=12 then c2=15 : goto1330
  132. 1320 if c2=15 then c2=0
  133. 1330 pokev+37,c2:return
  134. 1340 if c3=0  then c3=11 : goto1380
  135. 1350 if c3=11 then c3=12 : goto1380
  136. 1360 if c3=12 then c3=15 : goto1380
  137. 1370 if c3=15 then c3=0
  138. 1380 pokev+38,c3:return
  139. 1390 if c4=0  then c4=11 : goto1430
  140. 1400 if c4=11 then c4=12 : goto1430
  141. 1410 if c4=12 then c4=15 : goto1430
  142. 1420 if c4=15 then c4=0
  143. 1430 pokev+39,c4:pokev+40,c4:return
  144. 1440 pokev+21,0:pokev+28,0
  145. 1450 poke53280,11:poke53281,12:poke646,0
  146. 1460 gosub3090
  147. 1470 a1=22584:z=0:an=12288:s1=0
  148. 1480 print"";
  149. 1490 forth=0to20:printth:next:print"";
  150. 1500 forp=0to20:fork=0to2:f$="":ff$=""
  151. 1520 a=peek(an+(p*3)+k)
  152. 1530 form=3to0step-1
  153. 1540 forn=3to0step-1
  154. 1550 ifa>=2^(m*2+n)thena=a-2^(m*2+n):b=b+2^n
  155. 1560 nextn
  156. 1570 ifb=0thenf=c1
  157. 1580 ifb=1thenf=c2
  158. 1590 ifb=2thenf=c4
  159. 1600 ifb=3thenf=c3
  160. 1610 iff=0thenf$=f$+"111111":ff$=ff$+"111111"
  161. 1620 iff=11thenf$=f$+"110110"                       :ff$=ff$+"011011"
  162. 1630 iff=12thenf$=f$+"111000"                       :ff$=ff$+"000111"
  163. 1640 iff=15thenf$=f$+"000000":ff$=ff$+"000000"
  164. 1650 b=0:f=0:nextm
  165. 1660 forr=1to24
  166. 1670 ifmid$(f$,r,1)="1"theng=g+2^(24-r)
  167. 1680 ifmid$(ff$,r,1)="1"thenh=h+2^(24-r)
  168. 1690 nextr
  169. 1700 c=int(g/65536):d=int((g-(c*65536))/256):e=g-(c*65536+d*256):g=0
  170. 1710 pokea1+z+s1,c:pokea1+z+1+s1,d:pokea1+z+2+s1,e
  171. 1720 c=int(h/65536):d=int((h-c*65536)/256):e=h-(c*65536+d*256):h=0
  172. 1730 pokea1+z+11+s1,c:pokea1+z+12+s1,d:pokea1+z+13+s1,e
  173. 1740 z=z+3:nextk:s1=s1+22:z=0:print"+":nextp
  174. 1750 gosub3220:rem save
  175. 1760 gosub3360:rem disk error
  176. 1770 ifa=0thenrun
  177. 1780 print"  disk-error [146]: ";a;a$;b;c
  178. 1790 gosub3150
  179. 1800 goto1750
  180. 1810 rem ******************************
  181. 1820 rem 2 hires-sprites (nebeneinand.)
  182. 1830 rem ******************************
  183. 1840 az=2:gosub2940
  184. 1850 a$="2 hires-sprites (nebeneinand.)"
  185. 1860 gosub3090
  186. 1870 pokev+21,3
  187. 1880 poke2040,192:poke2041,193
  188. 1890 pokev,160:pokev+1,150
  189. 1900 pokev+2,184:pokev+3,150
  190. 1910 pokev+39,15:pokev+40,15
  191. 1920 gosub3640
  192. 1930 pokev+21,0
  193. 1940 gosub3050
  194. 1950 i=0 : a1=12288 : a2=12352 : aa=22695
  195. 1960 print"";
  196. 1970 forth=0to20:printth:next:print"";
  197. 1980 fort=1to3
  198. 1990 a=peek(a1)
  199. 2000 pokeaa,a
  200. 2010 aa=aa+1:a1=a1+1
  201. 2020 nextt
  202. 2030 fort=1to3
  203. 2040 b=peek(a2)
  204. 2050 pokeaa,b
  205. 2060 aa=aa+1:a2=a2+1
  206. 2070 nextt:aa=aa+5:i=i+1:print"+":ifi<21then1980
  207. 2080 gosub3220
  208. 2090 gosub3360
  209. 2100 ifa=0thenrun
  210. 2110 print"  disk-error [146]: ";a;a$;b;c
  211. 2120 gosub3150
  212. 2130 goto2080
  213. 2140 rem ******************************
  214. 2150 rem 2 hires-sprites (uebereinand.)
  215. 2160 rem ******************************
  216. 2170 az=2:gosub2940
  217. 2180 a$="2 hires-sprites (uebereinand.)"
  218. 2190 gosub3090
  219. 2200 pokev+21,3
  220. 2210 poke2040,192:poke2041,193
  221. 2220 pokev,172:pokev+1,155
  222. 2230 pokev+2,172:pokev+3,176
  223. 2240 pokev+39,15:pokev+40,15
  224. 2250 gosub3640
  225. 2260 pokev+21,0
  226. 2270 gosub3050 : rem fill mit 00
  227. 2280 aa=12288 : b=0 : z=0
  228. 2290 a1=22585
  229. 2300 print"";
  230. 2310 forth=0to20:printth:next:print"";
  231. 2320 forth=21to41:printtab(10)th:next:print"";
  232. 2330 for n=0 to 20
  233. 2340 print"+"
  234. 2350 form=0to2
  235. 2360 a=peek(aa+(n*3+m))
  236. 2370 for o=14 to 0 step -2
  237. 2380 if a>=2^(o/2)then b=b+2^(o+1):b=b+2^o:a=a-2^(o/2)
  238. 2390 nexto:pokea1+z,int(b/256):pokea1+z+1,b-peek(a1+z)*256
  239. 2400 z=z+2 :b=0 : next m:z=z+5
  240. 2410 next n
  241. 2420 aa=12352 : b=0 : z=0
  242. 2430 a1=22816
  243. 2440 print"";
  244. 2450 for n=0 to 20
  245. 2460 print"+"
  246. 2470 for m=0 to 2
  247. 2480 a=peek(aa+(n*3+m))
  248. 2490 for o=14 to 0 step -2
  249. 2500 if a>=2^(o/2)then b=b+2^(o+1):b=b+2^o:a=a-2^(o/2)
  250. 2510 nexto:pokea1+z,int(b/256):pokea1+z+1,b-peek(a1+z)*256
  251. 2520 z=z+2 :b=0 : next m:z=z+5
  252. 2530 next n
  253. 2540 gosub3220:rem save
  254. 2550 gosub3360:rem disk error
  255. 2560 ifa=0thenrun
  256. 2570 print"  disk-error [146]: ";a;a$;b;c
  257. 2580 gosub3150
  258. 2590 goto2540
  259. 2600 rem ******************************
  260. 2610 rem *****  4 hires-sprites   *****
  261. 2620 rem ******************************
  262. 2630 az=4:gosub2940
  263. 2640 a$="4 hires-sprites":gosub3090
  264. 2650 pokev+21,15
  265. 2660 poke2040,192:poke2041,193:poke2042,194:poke2043,195
  266. 2670 pokev,136:pokev+1,119
  267. 2680 pokev+2,160:pokev+3,119
  268. 2690 pokev+4,136:pokev+5,140
  269. 2700 pokev+6,160:pokev+7,140
  270. 2710 pokev+39,15:pokev+40,15:pokev+41,15:pokev+42,15
  271. 2720 gosub3640
  272. 2730 pokev+21,0
  273. 2740 gosub3050:remfill mit 00
  274. 2750 aa=12288 : ab=aa+64:ac=ab+64:ad=ac+64
  275. 2760 a1=22585 :a2=22588:a3=22816:a4=22819
  276. 2770 t=0:q=0
  277. 2780 print"";
  278. 2790 forth=0to20:printth:next:print"";
  279. 2800 forf=0to20
  280. 2810 print"+"
  281. 2820 fori=0to2:
  282. 2830 a=peek(aa+q):b=peek(ab+q):c=peek(ac+q):d=peek(ad+q)
  283. 2840 pokea1+t,a:pokea2+t,b:pokea3+t,c:pokea4+t,d
  284. 2850 q=q+1:t=t+1:next:t=t+8
  285. 2860 next f
  286. 2870 gosub3220:rem save
  287. 2880 gosub3360:rem disk error
  288. 2890 ifa=0thenrun
  289. 2900 print"  disk-error [146]: ";a;a$;b;c
  290. 2910 gosub3150
  291. 2920 goto2870
  292. 2930 rem******************************
  293. 2940 rem*****   load - routine   *****
  294. 2950 rem******************************
  295. 2960 sz=1:gosub3400
  296. 2970 if az=1 then return
  297. 2980 sz=2:gosub3400
  298. 2990 if az=2 then return
  299. 3000 sz=3:gosub3400
  300. 3010 if az=3 then return
  301. 3020 sz=4:gosub3400
  302. 3030 return
  303. 3040 rem******************************
  304. 3050 rem*****    fill mit 00     *****
  305. 3060 rem******************************
  306. 3070 fori=22528 to 23164 : pokei,0:next:return
  307. 3080 rem******************************
  308. 3090 rem****  print ueberschrift  ****
  309. 3100 rem******************************
  310. 3110 print"[147] ";a$;
  311. 3120 a=len(a$):a=a+1:fori=a to 39:print" [146]";:next
  312. 3130 return
  313. 3140 rem******************************
  314. 3150 rem*******   get any key   ******
  315. 3160 rem******************************
  316. 3170 print"    bitte druecken sie eine taste !!!  [146]";
  317. 3180 poke2023,160:poke56295,0
  318. 3190 getyy$:ifyy$=""then 3190
  319. 3200 return
  320. 3210 rem******************************
  321. 3220 rem*** save print-shop grafik ***
  322. 3230 rem******************************
  323. 3240 print"[147]":a$="save print-shop graphik":gosub3090
  324. 3250 print" name (save) :  ";:open1,0:input#1,sn$:close1:print
  325. 3260 open3,8,2,sn$+",p,w"
  326. 3270 print#3,chr$(0);chr$(88);
  327. 3280 for i=22528 to 23164 : print#3,chr$(peek(i));:next
  328. 3290 close3
  329. 3300 gosub3360
  330. 3310 ifa=0thenreturn
  331. 3320 print"  disk-error [146]: ";a;a$;b;c
  332. 3330 getyy$:ifyy$=""then3330
  333. 3340 goto3220
  334. 3350 rem******************************
  335. 3360 rem*****   disk-error ???   *****
  336. 3370 rem******************************
  337. 3380 open15,8,15:input#15,a,a$,b,c:close15
  338. 3390 return
  339. 3400 :
  340. 3410 a$="load routine ":gosub3090
  341. 3420 print"name fuer sprite #";sz;:open1,0:input#1,n$:close1:print
  342. 3430 n$=left$(n$,16)
  343. 3440 print" p[146]rogramm- o. s[146]equentielles file ?"
  344. 3450 gett$:ift$=""then3450
  345. 3460 if t$="p" then 3480
  346. 3470 if t$<>"s" then 3450
  347. 3480 open2,8,2,n$+","+t$+",r"
  348. 3490 if t$="p" then get#2,m$:get#2,m$
  349. 3500 fori = 0 to 62
  350. 3510 get#2,sp$:ifsp$=""thensp$=chr$(0)
  351. 3520 sp=asc(sp$)
  352. 3530 if sz=1 then poke12288+i,sp
  353. 3540 if sz=2 then poke12352+i,sp
  354. 3550 if sz=3 then poke12416+i,sp
  355. 3560 if sz=4 then poke12480+i,sp
  356. 3570 next:close2
  357. 3580 gosub3360 : if a=0 then return
  358. 3590 print"  disk error [146]: ";a;a$;b;c
  359. 3600 gosub3150
  360. 3610 goto 2940
  361. 3640 print"    richtiger sprite/sprites   (j/n)   [146]";
  362. 3650 poke2023,160:poke56295,0
  363. 3660 getg$:ifg$=""then3660
  364. 3670 ifg$="j"thenfori=1984to2023:pokei,32:next:return
  365. 3680 ifg$<>"n"then3660
  366. 3690 pokev+21,0:run
  367. 3700 rem******************************
  368. 3710 rem*****     directory      *****
  369. 3720 rem******************************
  370. 3730 print"[147]"
  371. 3740 open1,8,0,"$":kv=0
  372. 3750 fori=0to30:get#1,a$:b$=b$+a$:next
  373. 3760 print"  ";b$
  374. 3770 get#1,a$,b$,e$,f$,g$:fori=0to26:get#1,d$:c$=c$+d$:next
  375. 3780 iff$<=chr$(0)thena=0:goto3800
  376. 3790 a=asc(f$)
  377. 3800 ifg$<=chr$(0)thenb=0:goto3820
  378. 3810 b=asc(g$)
  379. 3820 d=a+256*b
  380. 3830 ifc$="[199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199][199]"thenc$="":goto3910
  381. 3840 ifc$="[255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255][255]"thenc$="":goto3910
  382. 3850 printd;c$:c$=""
  383. 3860 kv=kv+1:ifkv=22then3880
  384. 3870 goto3770
  385. 3880 kv=0:gosub3150
  386. 3890 print"[145]                                        ";:print"[147]":poke2023,32
  387. 3900 goto3770
  388. 3910 kv=0:gosub3150
  389. 3920 close1:run
  390.